home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / error_hn / eh / m90error.bas < prev    next >
Encoding:
BASIC Source File  |  1995-10-09  |  5.0 KB  |  148 lines
  1. 'ErrorHandler .bas file
  2. '
  3. 'this file is required inorder to provide error handling
  4. 'code to your application
  5. '
  6. ' DO NOT REMOVE IT !!!
  7. '
  8. ' ErrorHandler(c) Micro90 1995 UK
  9. ' tel +44 [0] 1202 667337
  10.  
  11.  
  12. 'Used to store process details
  13. Global gi_m90EHresult As Integer
  14. Global gs_m90EH_Formname As String
  15. Global gs_m90EH_Procname As String
  16. Global gi_m90EH_Putlog As Integer
  17. Global gi_m90EH_LastErrNo As Integer
  18. Global gi_m90EH_LastCounter As Integer
  19. Global Const gi_m90EH_LastRetry = 5
  20.  
  21. 'INTERNATIONALIZTIONERISUM
  22. Global Const gs_M90EH_dateformat = "DD/MM/YYYY"
  23. Global Const gs_M90EH_timeformat = "hh:nn ss"
  24.  
  25. 'localization
  26. Global gs_m90EH_AppPath As String
  27.  
  28. 'msgbox titles
  29. Global Const gs_m90EH_title = "ErrorHandler"
  30. Global Const gs_m90EH_contact = "Please Report Errors to Software supplier"
  31. Global Const gs_m90EH_application = "ErrorHandler"
  32.  
  33. Function gfi_M90ErrorHandler (ls_Formname As String, ls_Procname As String, li_Putlog As Integer) As Integer
  34.     'this is the main error handler
  35.     'DONT DELETE OR RENAME OR CHANGE IT...
  36.     '
  37.     'Micro90,+44 [0] 1202 667337
  38.     '
  39.  
  40.     Dim ls_error As String
  41.     Dim li_M90result As Integer
  42.     Dim RTN As String
  43.     Dim ls_m90_MSGtext As String
  44.  
  45.     RTN = Chr$(13)
  46.  
  47.     'get the error from the csv file
  48.     ls_error = Error
  49.  
  50.     'put details to error.log file
  51.     If li_Putlog Then
  52.         gp_M90Puterrorlog ls_Formname, ls_Procname, ls_error
  53.     End If
  54.  
  55.     'builds error message string
  56.     ls_m90_MSGtext = "An error has occured within the code : " & RTN & RTN
  57.     ls_m90_MSGtext = ls_m90_MSGtext & "Error No       : " & Format(Err) & RTN
  58.     ls_m90_MSGtext = ls_m90_MSGtext & "Description  : " & ls_error & RTN & RTN
  59.     ls_m90_MSGtext = ls_m90_MSGtext & "Form            : " & (ls_Formname) & RTN
  60.     ls_m90_MSGtext = ls_m90_MSGtext & "Sub/Fun       : " & (ls_Procname) & RTN & RTN
  61.     ls_m90_MSGtext = ls_m90_MSGtext & gs_m90EH_contact
  62.  
  63.     li_M90result = MsgBox(ls_m90_MSGtext, 50, gs_m90EH_title)
  64.     gfi_M90ErrorHandler = li_M90result
  65.     
  66.     'Repeatative error Quite questioning
  67.     'if the same error occurs more than N times give the user the chance to stop software
  68.     If gi_m90EH_LastErrNo = Err Then
  69.         gi_m90EH_LastCounter = gi_m90EH_LastCounter + 1
  70.         If gi_m90EH_LastCounter = gi_m90EH_LastRetry Then
  71.  
  72.             ls_m90_MSGtext = "An error has occured within the code : " & RTN & RTN
  73.             ls_m90_MSGtext = ls_m90_MSGtext & "Error No       : " & Format(Err) & RTN
  74.             ls_m90_MSGtext = ls_m90_MSGtext & "Description  : " & ls_error & RTN & RTN
  75.             ls_m90_MSGtext = ls_m90_MSGtext & "Form            : " & (ls_Formname) & RTN
  76.             ls_m90_MSGtext = ls_m90_MSGtext & "Sub/Fun       : " & (ls_Procname) & RTN & RTN
  77.             ls_m90_MSGtext = ls_m90_MSGtext & "Do you want to quit software ?"
  78.  
  79.             li_M90result = MsgBox(ls_m90_MSGtext, 20, gs_m90EH_title)
  80.             Select Case li_M90result
  81.             Case 6
  82.                'yes quit
  83.                gp_M90exit
  84.             Case 7
  85.                'no
  86.                gi_m90EH_LastCounter = 0
  87.                gfi_M90ErrorHandler = 4
  88.             End Select
  89.         End If
  90.     Else
  91.         gi_m90EH_LastCounter = 0
  92.     End If
  93.  
  94.     gi_m90EH_LastErrNo = Err
  95.  
  96.     SCREEN.MousePointer = 0
  97.  
  98. End Function
  99.  
  100. Sub gp_M90exit ()
  101.     'this sub will end your application if the user selects abort
  102.  
  103.  
  104.     End
  105.  
  106.  
  107. End Sub
  108.  
  109. Sub gp_M90Puterrorlog (ls_Formname As String, ls_Procname As String, ls_error As String)
  110.     'this sub will write the error details to file in the error.log
  111.     'if the file does not exist then it will create it.
  112.  
  113.     Dim li_freefile As Integer
  114.     Dim ls_errorblock As String
  115.     Dim RTN As String
  116.  
  117.     RTN = Chr$(13) & Chr$(10)
  118.  
  119.     'build error
  120.     ls_errorblock = ""
  121.     ls_errorblock = ls_errorblock & "----------------------------------------------------" & RTN
  122.     ls_errorblock = ls_errorblock & "ERROR HANDLER REPORT " & RTN
  123.     ls_errorblock = ls_errorblock & "" & RTN
  124.     ls_errorblock = ls_errorblock & "time (" & gs_M90EH_timeformat & ")  = " & Format(Now, gs_M90EH_timeformat) & RTN
  125.     ls_errorblock = ls_errorblock & "date(" & gs_M90EH_dateformat & ") = " & Format(Now, gs_M90EH_dateformat) & RTN
  126.     ls_errorblock = ls_errorblock & "Application      = " & gs_m90EH_application & RTN
  127.     ls_errorblock = ls_errorblock & "Form             = " & ls_Formname & RTN
  128.     ls_errorblock = ls_errorblock & "Sub/Fun          = " & ls_Procname & RTN
  129.     ls_errorblock = ls_errorblock & "" & RTN
  130.     ls_errorblock = ls_errorblock & "Error No         = " & Format(Err) & RTN
  131.     ls_errorblock = ls_errorblock & "Description      = " & ls_error & RTN
  132.  
  133.     'Check Path for error log
  134.     gs_m90EH_AppPath = app.Path
  135.     If Not Mid$(gs_m90EH_AppPath, Len(gs_m90EH_AppPath), 1) = "\" Then
  136.            gs_m90EH_AppPath = gs_m90EH_AppPath & "\"
  137.     End If
  138.  
  139.     'write error
  140.     li_freefile = FreeFile
  141.     Open gs_m90EH_AppPath & "error.log" For Append As li_freefile
  142.         Print #li_freefile, ls_errorblock
  143.     Close li_freefile
  144.  
  145.  
  146. End Sub
  147.  
  148.